home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
tex
/
dfutil2.zip
/
FREPLACE.ZIP
/
FREPLACE.BAS
next >
Wrap
BASIC Source File
|
1990-11-10
|
4KB
|
145 lines
'FREPLACE replaces strings in files
'
' $INCLUDE: 'qb.bi'
DECLARE FUNCTION exists (filename$)
DIM SHARED inregs AS RegTypeX, outregs AS RegTypeX
CONST YES = 1, NO = 0
DIM arg$(10)
inline$ = COMMAND$
ch = 1: word = 1
WHILE ch <= LEN(inline$)
ch$ = MID$(inline$, ch, 1)
IF ch$ <> " " THEN
arg$(word) = arg$(word) + ch$
IF ch$ = "<" THEN
WHILE NOT ch$ = ">"
ch = ch + 1
ch$ = MID$(inline$, ch, 1)
arg$(word) = arg$(word) + ch$
WEND
END IF
ELSE
word = word + 1
END IF
ch = ch + 1
WEND
IF NOT arg$(1) = "" THEN GOTO BEGINNING
HELP:
PRINT " "
PRINT "FREPLACE replaces or deletes strings in a file. "
PRINT "(c) 1990 David A. Wesson"
PRINT " "
PRINT "Syntax: FREPLACE [d:]filename [Oldstring Newstring]"
PRINT " where filename = original file [drive optional] "
PRINT " Oldstring = string to be replaced, delimited by < and >"
PRINT " Newstring = replacement, delimited by < and > "
PRINT ""
PRINT "If Oldstring is missing, you will be prompted for OLD and NEW strings."
PRINT "If Newstring is missing, the OLD string is deleted."
PRINT ""
PRINT "NOTE: Lines may not be longer than 254 characters."
PRINT " Because the command line only works in UPPERCASE,"
PRINT " if you want to replace a string with a lowercase"
PRINT " string, you must use the prompts to enter this text."
PRINT " This program makes a backup of the original file"
PRINT " named filename.OLD"
END
BEGINNING:
infile$ = UCASE$(arg$(1))
IF exists(infile$) = NO THEN GOTO nofind
OPEN infile$ FOR INPUT AS #1
outfile$ = "temp"
OPEN outfile$ FOR OUTPUT AS #2
GOSUB filename
oldfile$ = file$ + ".OLD"
ROUTINE:
COLOR 15: PRINT "FREPLACE "; : COLOR 7: PRINT "Fast string replacer or deleter"
GETSTRINGS:
oldstring$ = arg$(2)
newstring$ = arg$(3)
IF oldstring$ = "" THEN
INPUT "OLD string: ", oldstring$
INPUT "NEW string: ", newstring$
END IF
IF oldstring$ = newstring$ THEN GOTO badstring
IF newstring$ = "" THEN newstring$ = "NOTHING"
PRINT "Replacing "; oldstring$; " with "; newstring$; " in "; infile$; ", creating "; oldfile$
PRINT "Hit [Ctrl]+[Break] to terminate."
PRINT "Starting time: "; TIME$
PRINT " Processing: ";
z = 0
cleanstrings:
IF LEFT$(oldstring$, 1) = "<" THEN oldstring$ = MID$(oldstring$, 2)
IF RIGHT$(oldstring$, 1) = ">" THEN oldstring$ = LEFT$(oldstring$, LEN(newstring$) - 1)
IF LEFT$(newstring$, 1) = "<" THEN newstring$ = MID$(newstring$, 2)
IF RIGHT$(newstring$, 1) = ">" THEN newstring$ = LEFT$(newstring$, LEN(newstring$) - 1)
CYCLE:
IF EOF(1) THEN GOTO FINISH
LINE INPUT #1, l$
z = z + 1
strt = 1
LOCATE , 15: PRINT z;
search:
lfpos = INSTR(strt, UCASE$(l$), UCASE$(oldstring$))
IF lfpos < 1 THEN GOTO DUMP
GOTO SPLIT
NEXTLOOK:
strt = lfpos + LEN(oldstring$): GOTO search
SPLIT:
lpart$ = LEFT$(l$, lfpos - 1)
rpos = lfpos + LEN(oldstring$) - 1
rpart$ = RIGHT$(l$, LEN(l$) - rpos)
s$ = lpart$ + newstring$ + rpart$
NEWOUT:
PRINT #2, s$
GOTO CYCLE
DUMP:
PRINT #2, l$
GOTO CYCLE
FINISH:
CLOSE
IF exists(oldfile$) = YES THEN KILL oldfile$
NOOLD:
NAME infile$ AS oldfile$
NAME outfile$ AS infile$
PRINT ""
PRINT " Finish time: "; TIME$
END
'******************************** GENERAL SUBROUTINES *************************
nofind:
PRINT "ERROR: No file by that name found."
GOTO HELP
badstring:
PRINT "ERROR: NEWSTRING cannot be the same as OLDSTRING."
GOTO HELP
filename: 'splits infile$ into
period = INSTR(infile$, ".") 'file$ and ext$
IF period = 0 THEN
file$ = infile$
ext$ = ""
ELSE
file$ = LEFT$(infile$, period - 1)
ext$ = MID$(infile$, period + 1)
END IF
RETURN
FUNCTION exists (search$)
savefile$ = search$
inregs.ax = &H4E00
inregs.cx = 1 '3 for hidden
search$ = search$ + CHR$(0)
inregs.dx = SADD(search$)
inregs.ds = -1
CALL INTERRUPTX(&H21, inregs, outregs)
IF (outregs.flags AND 1) = 1 THEN
exists = NO
ELSE
exists = YES
END IF
search$ = savefile$
END FUNCTION